home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0152_Graphics Readln-ReadKey etc..pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  29KB  |  769 lines
  1. {
  2. > I wrote a procedure that read a string input from the keyboard and
  3. > returns an integer value. But how can I limit the length of the string
  4. > to be inputed? And can any one please provide a source code that does
  5. > the same thing in graphic mode? Thanx in advance.
  6.  
  7.    This is old Code, Written originally for a Hercules card, but with a
  8.  little twiddling it should work just fine.  Improvements I can think
  9.  of, Making the cursor blink, Making the cursor the correct size...
  10.  
  11.     Anyway, here goes.   Hang on this is pretty long!
  12. }
  13.  
  14. {****************************************************************************}
  15. {                  Unit to Compute in a Very Pascal Way                      }
  16. {****************************************************************************}
  17. {                     Incredible Graphix Utilities                           }
  18. {****************************************************************************}
  19. {****************************************************************************}
  20. {     Version : 3.0                                         JUL  1993        }
  21. {****************************************************************************}
  22. Unit Grfxutil ;
  23. {****************************************************************************}
  24. Interface
  25. {****************************************************************************}
  26. type
  27.      commands = (NON,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,F13,F14,F15,F16,
  28.         F17,F18,F19,F20,F21,F22,F23,F24,F25,F26,F27,F28,F29,F30,F31,F32,F33,
  29.         F34,F35,F36,F37,F38,F39,F40,HOME,UP,PGUP,LFT,RGHT,END1,DWN,PGDN,INS,
  30.         DEL,PRTSRN,ENT,TAB,SPACE,BKSPAC,ESC,SHTAB,CTRLLFT,CTRLRGHT,CTRLUP,
  31.         CTRLDWN,CTRLHOME,CTRLEND1,CTRLPGUP,CTRLPGDN) ;
  32. var
  33.    Greypic     : pointer ;              { The Grey Picture                   }
  34.    comm        : commands ;             { The Command from the keyboard      }
  35.    NoEcho      : Boolean ;              { If Characters are echoed.          }
  36.    Cwn         : String ;
  37. {****************************************************************************}
  38. Function Testbit(testin : longint ; position : byte) : boolean ;
  39. Function SetBit(Testin : longint ; Position : byte) : longint ;
  40. Procedure Report_Mouse_Position ;  { A Debuging and design tool }
  41. Procedure Register_Graphics
  42.              (videodriver,videomode : integer ; var videographicsmode : byte) ;
  43. Procedure clrvp(l1,l2,l3,l4 : integer ) ;
  44. Procedure SAP( P : byte ) ;
  45. Procedure clrpage ;
  46. procedure DblBox (X1,Y1,X2,Y2 : Integer) ;
  47. Procedure Dblwindowbox(x1,y1,x2,y2 : integer ; boxheader : string) ;
  48. Procedure WindowBox(x1,y1,x2,y2 : integer ; boxheader : string) ;
  49. Function  Roll(faces : integer) : integer ;
  50. Function  Getcommand(VAR ch : char) : commands ;
  51.  
  52.  
  53.  
  54. { These are the ones you are interested in. }
  55.  
  56. Procedure Readxy (X,Y:integer; Var S : string ; L : integer) ;
  57. Function  GetReal(X,Y : integer; am : real; w : integer) : real ;
  58. Function  getInteger(X,Y,N,W : integer) : integer  ;
  59. Procedure Greyoutxy(x,y : integer ; textstring : string) ;
  60. Function YesNoDialog : boolean ;
  61. {****************************************************************************}
  62. implementation uses crt,dos,Graph,bgidriv,bgifont,mousutil;
  63. {****************************************************************************}
  64. Function TestBit ;
  65. var
  66.    maskbit : longint ;
  67. begin
  68.      case position of
  69.      1   : maskbit := 1 ;
  70.      2   : maskbit := 2 ;
  71.      3   : maskbit := 4 ;
  72.      4   : maskbit := 8 ;
  73.      5   : maskbit := 16 ;
  74.      6   : maskbit := 32 ;
  75.      7   : maskbit := 64 ;
  76.      8   : maskbit := 128 ;
  77.      9   : maskbit := 256 ;
  78.      10  : maskbit := 512 ;
  79.      11  : maskbit := 1024 ;
  80.      12  : maskbit := 2048 ;
  81.      13  : maskbit := 4096 ;
  82.      14  : maskbit := 8192 ;
  83.      15  : maskbit := 16384 ;
  84.      16  : maskbit := 32768 ;
  85.      17  : maskbit := 65536 ;
  86.      18  : maskbit := 131072 ;
  87.      19  : maskbit := 262144 ;
  88.      20  : maskbit := 524288 ;
  89.      21  : maskbit := 1048576 ;
  90.      22  : maskbit := 2097152 ;
  91.      23  : maskbit := 4194304 ;
  92.      24  : maskbit := 8388608 ;
  93.      25  : maskbit := 16777216 ;
  94.      26  : maskbit := 33554432 ;
  95.      27  : maskbit := 67108864 ;
  96.      28  : maskbit := 134217728 ;
  97.      29  : maskbit := 268435456 ;
  98.      30  : maskbit := 536870912 ;
  99.      31  : maskbit := 1073741824 ;
  100.      end ;
  101.      if (testin and maskbit) = maskbit then testbit := true
  102.      else testbit := false ;
  103. end ;
  104.  
  105. {****************************************************************************}
  106. { This function sets the state of a bit in a variable as large as a longint.
  107. You call it with the value of the variable and the position (counting from
  108. right to left naturally).  If the bit is already set, then it will turn it
  109. off, if it is off then it will turn it on. }
  110. Function setBit ;
  111. var
  112.    maskbit : longint ;
  113. begin
  114.      case position of
  115.      1   : maskbit := 1 ;
  116.      2   : maskbit := 2 ;
  117.      3   : maskbit := 4 ;
  118.      4   : maskbit := 8 ;
  119.      5   : maskbit := 16 ;
  120.      6   : maskbit := 32 ;
  121.      7   : maskbit := 64 ;
  122.      8   : maskbit := 128 ;
  123.      9   : maskbit := 256 ;
  124.      10  : maskbit := 512 ;
  125.      11  : maskbit := 1024 ;
  126.      12  : maskbit := 2048 ;
  127.      13  : maskbit := 4096 ;
  128.      14  : maskbit := 8192 ;
  129.      15  : maskbit := 16384 ;
  130.      16  : maskbit := 32768 ;
  131.      17  : maskbit := 65536 ;
  132.      18  : maskbit := 131072 ;
  133.      19  : maskbit := 262144 ;
  134.      20  : maskbit := 524288 ;
  135.      21  : maskbit := 1048576 ;
  136.      22  : maskbit := 2097152 ;
  137.      23  : maskbit := 4194304 ;
  138.      24  : maskbit := 8388608 ;
  139.      25  : maskbit := 16777216 ;
  140.      26  : maskbit := 33554432 ;
  141.      27  : maskbit := 67108864 ;
  142.      28  : maskbit := 134217728 ;
  143.      29  : maskbit := 268435456 ;
  144.      30  : maskbit := 536870912 ;
  145.      31  : maskbit := 1073741824 ;
  146.      end ;
  147.      setbit := testin xor maskbit ;
  148. end ;
  149.  
  150. {****************************************************************************}
  151.  
  152. Procedure Report_Mouse_position ;
  153. { This is a debugging and Designing tool, it reports the X,Y position of the
  154. mouse and shows free memory in the upper right corner of the screen. }
  155. var
  156.    msxstr,msystr : string[6] ;
  157.    Memstr : string[10] ;
  158.  
  159. Begin
  160.      str(memavail,memstr) ;
  161.      str(getmousex,msxstr) ;
  162.      str(getmouseY,msystr) ;
  163.      msxstr := 'X: ' + msxstr ;
  164.      msystr := 'Y: ' + msystr ;
  165.      settextstyle(0,0,1) ;
  166.      setfillstyle(solidfill,darkgray) ;
  167.      bar(getmaxx-30,3,getmaxx-4,20) ;
  168.      bar(530,5,580,15) ;
  169.      setcolor(white) ;
  170.      outtextxy(530,5,memstr);
  171.      outtextxy(getmaxx-53,4,msxstr) ;
  172.      outtextxy(getmaxx-53,13,msystr) ;
  173. end ;
  174. {****************************************************************************}
  175. { Loads and registers the graphics driver }
  176. Procedure Register_Graphics
  177. (videodriver,videomode : integer ; var videographicsmode : byte) ;
  178. var
  179.   GraphDriver, GraphMode, Error : integer;
  180.   gotgrafix : boolean ;
  181.   mode : byte ;
  182.   regs : registers ;
  183. {*************************************************}
  184. procedure Abort(Msg : string);
  185. begin
  186.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  187.   Halt(4);
  188. end;
  189. {*************************************************}
  190. begin   { Register Graphix  }
  191.      if RegisterBGIdriver(@EGAVGADriverProc) < 0 then Abort('EGA/VGA');
  192. {     if RegisterBGIdriver(@HercDriverProc) < 0 then Abort('Herc');
  193.      if RegisterBGIdriver(@ATTDriverProc) < 0 then Abort('AT&T');
  194.      if RegisterBGIdriver(@PC3270DriverProc) < 0 then Abort('PC 3270');
  195. }
  196.                            { Register all the fonts }
  197. {     if RegisterBGIfont(@GothicFontProc) < 0 then Abort('Gothic');
  198.      if RegisterBGIfont(@SansSerifFontProc) < 0 then Abort('SansSerif');
  199.      if RegisterBGIfont(@SmallFontProc) < 0 then Abort('Small');
  200.      if RegisterBGIfont(@TriplexFontProc) < 0 then Abort('Triplex');
  201. }     graphdriver := videodriver ;
  202.      graphmode := videomode ;
  203.  
  204.      initgraph(graphdriver,graphmode,'') ;
  205.      if GraphResult <> grOk then             { any errors? }
  206.      begin
  207.           Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
  208.           Halt(4);
  209.      end;
  210. End ; { Register Graphics }
  211.  
  212. {****************************************************************************}
  213. { Clears a viewport passed to it and resets the viewport }
  214. { instead of writing it so many times!! }
  215. Procedure clrvp(l1,l2,l3,l4 : integer ) ;
  216. var
  217.    vp : viewporttype ;
  218. begin
  219.      getviewsettings(vp) ;
  220.      setviewport(l1,l2,l3,l4,clipon) ;
  221.      clearviewport ;
  222.      setviewport(vp.x1,vp.y1,vp.x2,vp.y2,vp.clip) ; { Restore the viewport }
  223. end ;
  224. {****************************************************************************}
  225. { Sets Apage, activepage, visualpage }
  226. Procedure SAP ;
  227.  
  228. begin   { SAP }
  229.      setactivepage(p) ; setvisualpage(p) ;
  230. end ;   { SAP }
  231. {****************************************************************************}
  232. { Clears the current page number }
  233. Procedure clrpage ;
  234.  
  235. begin   { Clrpage }
  236.      clrvp(0,0,getmaxx,getmaxy) ;
  237. end ;   { Clrpage }
  238. {****************************************************************************}
  239. { Puts down a double Lined Box }
  240. procedure DblBox ;
  241.  
  242. begin   { DblBox }
  243.      line(x1,y1,x2,y1) ; line(x1 + 2,y1 + 2,x2 - 2,y1 + 2) ;
  244.      line(x1,y2,x2,y2) ; line(x1 + 2,y2 - 2,x2 - 2,y2 - 2) ;
  245.      line(x1,y1,x1,y2) ; line(x1 + 3,y1 + 3,x1 + 3,y2 - 3) ;
  246.      line(x2,y1,x2,y2) ; line(x2 - 3,y1 + 3,x2 - 3, y2 - 3) ;
  247. end ;   { DblBox }
  248. {****************************************************************************}
  249. { Creates a double lined box with an optional header }
  250. Procedure Dblwindowbox(x1,y1,x2,y2 : integer ; boxheader : string) ;
  251. var
  252.    oldstyle : textsettingstype ;
  253. begin
  254.      line(x1,y1,x2,y1) ;
  255.      if length(boxheader) = 0 then line(x1 + 2,y1 + 2,x2 - 2,y1 + 2)
  256.      else line(x1,y1 + textheight('H') + 2,x2,y1 + textheight('H') + 2) ;
  257.      line(x1,y2,x2,y2) ;
  258.      line(x1 + 2,y2 - 2,x2 - 2,y2 - 2) ;
  259.      line(x1,y1,x1,y2) ;
  260.      line(x1 + 2,y1 + 2,x1 + 2,y2 - 2) ;
  261.      line(x2,y1,x2,y2) ;
  262.      line(x2 - 2,y1 + 2,x2 - 2, y2 - 2) ;
  263.      line(x1+2,y1,x1+2,y1+10) ;
  264.      line(x2-2,y1,x2-2,y1+10) ;
  265.      if length(boxheader) >0 then
  266.      begin
  267.           gettextsettings(oldstyle);
  268.           settextjustify(1,0) ;
  269.           outtextxy(x1+ ((x2-x1) div 2),y1+ textheight('H') + 2,boxheader) ;
  270.           with oldstyle do
  271.           begin
  272.                settextjustify(horiz,vert) ;
  273.                settextstyle(font,direction,charsize) ;
  274.           end ;
  275.      end ;
  276. end ;
  277. {****************************************************************************}
  278. { Creates a Single lined box with an optional header }
  279. Procedure windowbox(x1,y1,x2,y2 : integer ; boxheader : string) ;
  280. var
  281.    oldstyle : textsettingstype ;
  282. begin
  283.      line(x1,y1,x2,y1) ;
  284.      if length(boxheader) > 0 then
  285.       line(x1,y1 + textheight('H') + 2,x2,y1 + textheight('H') + 2) ;
  286.      line(x1,y2,x2,y2) ;
  287.      line(x1,y1,x1,y2) ;
  288.      line(x2,y1,x2,y2) ;
  289.      if length(boxheader) >0 then
  290.      begin
  291.           gettextsettings(oldstyle);
  292.           settextjustify(1,0) ;
  293.           outtextxy(x1+((x2-x1) div 2),y1+textheight('H') + 1,boxheader) ;
  294.           with oldstyle do
  295.           begin
  296.                settextjustify(horiz,vert) ;
  297.                settextstyle(font,direction,charsize) ;
  298.           end ;
  299.      end ;
  300. end ;
  301.  
  302. {****************************************************************************}
  303. { An Any sided Die }
  304. Function Roll(faces : integer) : integer ;
  305. begin
  306.      roll := random(faces) + 1 ;
  307. end ;
  308. {****************************************************************************}
  309. { Returns A Commandkey From A Keypress or a Character }
  310. { The Function will return a command and it will  record the key in
  311. the variable parameter.  So you can use it to find any key pressed on
  312. the keyboard.}
  313. Function  Getcommand(VAR ch : char) : commands ;
  314. Var
  315.      C : Commands ;
  316.      funckey : boolean ;
  317.      newcommand : boolean ;
  318.  
  319. Begin  { Get Command }
  320.      newcommand := false ;
  321.      C := NON ;
  322.      if keypressed then
  323.      begin
  324.           newcommand := true ;
  325.           Ch := Readkey ;
  326.      end ;
  327.      if newcommand then
  328.      begin  { get the command }
  329.      If Ch <> #0 Then Funckey := False
  330.      Else
  331.      Begin
  332.           Funckey := True ;
  333.           Ch := Readkey ;
  334.      End ;
  335.      If Funckey Then
  336.      Case Ch Of
  337.  { The Normal Function Keys }
  338.      #59 : C := F1 ;        {F1}
  339.      #60 : C := F2 ;        {F2}
  340.      #61 : C := F3 ;        {F3}
  341.      #62 : C := F4 ;        {F4}
  342.      #63 : C := F5 ;        {F5}
  343.      #64 : C := F6 ;        {F6}
  344.      #65 : C := F7 ;        {F7}
  345.      #66 : C := F8 ;        {F8}
  346.      #67 : C := F9 ;        {F9}
  347.      #68 : C := F10 ;       {F10}
  348.    { Shifted Function Keys }
  349.      #133,#84 : C := F11 ;  {F11}
  350.      #134,#85 : C := F12 ;  {F12}
  351.      #86 : C := F13 ;       {F13}
  352.      #87 : C := F14 ;       {F14}
  353.      #88 : C := F15 ;       {F15}
  354.      #89 : C := F16 ;       {F16}
  355.      #90 : C := F17 ;       {F17}
  356.      #91 : C := F18 ;       {F18}
  357.      #92 : C := F19 ;       {F19}
  358.      #93 : C := F20 ;       {F20}
  359.    { Cntl Function Keys }
  360.      #94 : C := F21 ;       {F21}
  361.      #95 : C := F22 ;       {F22}
  362.      #96 : C := F23 ;       {F23}
  363.      #97 : C := F24 ;       {F24}
  364.      #98 : C := F25 ;       {F25}
  365.      #99 : C := F26 ;       {F26}
  366.      #100 : C := F27 ;      {F27}
  367.      #101 : C := F28 ;      {F28}
  368.      #102 : C := F29 ;      {F29}
  369.      #103 : C := F30 ;      {F30}
  370.  
  371.    { Alt Function Keys }
  372.      #104 : C := F31 ;      {F31}
  373.      #105 : C := F32 ;      {F32}
  374.      #106 : C := F33 ;      {F33}
  375.      #107 : C := F34 ;      {F34}
  376.      #108 : C := F35 ;      {F35}
  377.      #109 : C := F36 ;      {F36}
  378.      #110 : C := F37 ;      {F37}
  379.      #111 : C := F38 ;      {F38}
  380.      #112 : C := F39 ;      {F39}
  381.      #113 : C := F40 ;      {F40}
  382.          { The Keypad }
  383.      #71 : C := HOME;   {HOME}
  384.      #72 : C := UP ;   {UP}
  385.      #73 : C := PGUP ;   {PGUP}
  386.      #75 : C := LFT ;   {LEFT}
  387.      #77 : C := RGHT ;   {RIGHT}
  388.      #79 : C := END1 ;   {END}
  389.      #80 : C := DWN ;   {DOWN}
  390.      #81 : C := PGDN ;   {PGDN}
  391.      #82 : C := INS ;   {INS}
  392.      #83 : C := DEL ;   {DEL}
  393.      #114 : C := PRTSRN ; { Cntl - PrtSc }
  394.      #15 : C := SHTAB ;  { Shft Tab }
  395.      End  { Case }
  396.      else    { Not a function Key }
  397.      case ch of
  398.      #13 : C := ENT ;    { Return }
  399.      #27 : C := ESC ;    { Escape }
  400.      #32 : C := SPACE ;  { Space Bar }
  401.      #9  : C := TAB ;    { Tab }
  402.      #8  : C := BKSPAC ; { Back Space }
  403.      end ;   { Case }
  404.      end ;
  405.      Getcommand := C ;
  406. End ;  {Getcommand}
  407. {****************************************************************************}
  408. Procedure readxy ;
  409.  
  410. Var
  411.      Ch : Char ;
  412.      Done,Nomore,Inson,Funckey,curson : Boolean ;
  413.      Curp,Cx,Cy,Sx,Sy,StrCnt,I,x1,x2,y1,y2 : Integer ;
  414.      Outstr : string ;
  415.      cmmd : commands ;
  416.      Spac : integer ;
  417. {*******************************************}
  418. { Place the Cursor and update the cursor on flag }
  419. { With I we can force the cursor on or off or let it operate automaticly
  420. if I = 0 then turn the cursor off, if 1 then automatic, if 2 then on. }
  421. Procedure PpCur(I : integer) ;
  422. var
  423.    udc : boolean ;
  424. begin   { ppcur }
  425.      udc := false ;
  426.      if (cx >= x1) and (cx < x2) then udc := true ;
  427.      if udc then
  428.      begin
  429.           case I of
  430.           0 : setcolor(black) ;
  431.           1 : if curson then setcolor(black) else setcolor(white) ;
  432.           2 : setcolor(white) ;
  433.           end ;
  434.           if inson then setlinestyle(0,$FFFF,3) else setlinestyle(0,$FFFF,1) ;
  435.           line(cx,cy+textheight('H')+1,cx+textwidth('X'),cy+textheight('H')+1)
  436. ;          curson := not(curson) ;
  437.           if I = 2 then curson := true ;
  438.           if I = 0 then curson := false ;
  439.      end ;
  440.      setcolor(white) ;
  441. end ;   { ppcur }
  442.  
  443. {*******************************************}
  444. { Go to the end of the line, wherever it may be... }
  445. Procedure Goend ;
  446. Begin
  447.      ppcur(0) ; { Erase the old cursor }
  448.      Cx := Sx + Length(S) * Spac ;
  449.      Strcnt := Length(S) + 1 ;
  450.      ppcur(2) ; { Place the new cursor }
  451. End ;
  452.  
  453.  
  454. {*******************************************}
  455. Begin   { Readpgrf }
  456.      curson := false ; Strcnt := 1 ; Inson := False ;
  457.      Outstr := '' ; Nomore := False ;
  458.      spac := textwidth('X') ;
  459.      Sx := X ;
  460.      Sy := Y ;
  461.      Cx := Sx ;
  462.      Cy := Sy ;    { Set the Current x & y }
  463.  
  464.      y2 := y + spac ;
  465.      x1 := x ;
  466.      x2 := x1 + L * spac ;
  467.      y1 := y ;
  468.      moveto(x,y) ;
  469.      outtext(S) ;
  470.      ppcur(2) ;
  471.      Done := False ; While Not Done Do
  472.      Begin
  473.           ch := chr(1) ; { Clears the char }
  474.           cmmd := getcommand(ch) ;
  475.           if (cmmd <> NON) and (cmmd <> SPACE) then
  476.           Case CMMD Of
  477.           HOME : Begin   {HOME}
  478.                       Strcnt := 1 ;
  479.                       ppcur(1) ;
  480.                       Cx := Sx ;
  481.                       Cy := Sy ;
  482.                       ppcur(2) ;
  483.                  End ;
  484.           LFT  : Begin   { Left }
  485.                       If Cx >= X1 + Spac Then
  486.                       Begin
  487.                            if cx <= x2 - spac then ppcur(1) ;
  488.                            Cx := Cx - Spac ;
  489.                            ppcur(2) ;
  490.                            Dec(Strcnt) ;
  491.                            If Strcnt < 1 Then Strcnt := 1 ;
  492.                       End ;
  493.                  End ;  { UP }
  494.           RGHT : Begin   { Right }
  495.                       If Cx < X2 - Spac Then
  496.                       Begin
  497.                            ppcur(1) ;
  498.                            Cx := Cx + Spac ;
  499.                            ppcur(1) ;
  500.                            If Strcnt = Length(S) + 1 Then
  501.                            Begin
  502.                                 Insert(' ',S,Strcnt) ;
  503.                                 outtextxy(Cx,Cy,' ') ;
  504.                                 Inc(Strcnt) ;
  505.                            End
  506.                            Else Inc(Strcnt) ;
  507.                       end ;
  508.                  End ;   {RIGHT}
  509.           END1 : Goend ;
  510.           INS  : Begin   { INS }
  511.  
  512.                       If Inson = False Then
  513.                       begin
  514.                       If Integer(Length(S) * Spac)
  515.                        < Integer(X2 - X1 - Spac) Then Inson := True ;
  516.                       end else
  517.                       begin
  518.                            ppcur(0) ;
  519.                            Inson := False ;
  520.                       end ;
  521.                       ppcur(2) ;
  522.                  End ;   { INS }
  523.           DEL  : If Strcnt < Length(S) + 1 Then
  524.                  Begin
  525.                       Delete(S,Strcnt,1) ;
  526.                       Moveto(Cx,Cy) ;
  527.                       For I := Strcnt To Length(S) Do
  528.                        if noecho then Outstr := outstr + '.'
  529.                         else outstr := Outstr + S[I] ;
  530.                       clrvp(Cx,Cy,X2,Y2) ;
  531.                       Outtextxy(cx,cy,Outstr) ;
  532.                       Outstr := '' ;
  533.                       ppcur(2) ;
  534.                  End ;
  535.           BKSPAC : If Strcnt > 1 Then
  536.                  Begin
  537.                       If Cx <= X2 - Spac Then
  538.                       ppcur(0) ;
  539.                       dec(Cx,Spac) ;   { Right - Normal   }
  540.                       If Cx < 0 Then Cx := 0 ;
  541.                       Nomore := False ;
  542.                       Dec(Strcnt) ;
  543.                       If Strcnt < Length(S) Then
  544.                       Begin
  545.                            Moveto(Cx,Cy) ;
  546.                            Delete(S,Strcnt,1) ;
  547.                            For I := Strcnt To Length(S) Do
  548.                             if noecho then Outstr := outstr + '.'
  549.                             else Outstr := Outstr + S[I] ;
  550.                            clrvp(Cx,cy,x2,y2) ;
  551.                            Outtextxy(cx,cy,Outstr) ;
  552.                            Outstr := '' ;
  553.                            ppcur(2) ;
  554.                       End
  555.                       Else
  556.                       Begin
  557.                            ppcur(0) ;
  558.                            If Length(S) <= 1 Then
  559.                             S:= '' Else Delete(S,Strcnt,1) ;
  560.                             clrvp(cx,cy,x2,y2) ;
  561.                             ppcur(2) ;
  562.                       End ;
  563.                  End ;
  564.           ESC :  Begin  { ESC }
  565.                       ppcur(1) ;
  566.                       S := '' ;
  567.                       clrvp(X1,Y1,X2,Y2) ;
  568.                       Cx := Sx ; Cy := Sy ;
  569.                       ppcur(1) ;
  570.                       nomore := false ;
  571.                       Strcnt := 1 ;
  572.                  End ;
  573.           ENT   : Done := True ;      { Return }
  574.           end  { Case cmmd }
  575.           Else   { Not a command But A Key }
  576.           case ch of
  577.           ' '..'~':     Begin
  578.                          If Integer(Length(S) * Spac) >
  579.                                (x2 - X1 - Spac) Then Nomore := True ;
  580.                          If (Inson = False)
  581.                                   And
  582.                             (Strcnt < Length(S) + 1)
  583.                             Then Nomore := False ;
  584.                          If Not Nomore Then
  585.                          Begin { Not Nomore }
  586.                               ppcur(1) ;
  587.                               If Inson Then
  588.                               Begin  { Inson }
  589.                                    Insert(Ch,S,Strcnt) ;
  590.                                    If Strcnt < Length(S) Then
  591.                                    Begin  { < Length }
  592.                                    clrvp(Cx,Cy,X2,Y2) ;
  593.                                         Moveto(Cx,Cy) ;
  594.                                         For I := Strcnt To Length(S) Do
  595.                                          if noecho then Outstr := outstr + '.'
  596.                                          else Outstr := Outstr + S[I] ;
  597.                                         Outtext(Outstr) ;
  598.                                         Outstr := '' ;
  599.                                         Inc(Strcnt) ;
  600.                                    End  { < Length }
  601.                                    Else
  602.                                    Begin  { = Length }
  603.                                         if noecho then outtextxy(cx,cy,'.')
  604.                                         else outtextxy(Cx,Cy,ch) ;
  605.                                         curson := false ;
  606.                                         Inc(Strcnt) ;
  607.                                    End ;  { = Length }
  608.                               End { Inson }
  609.                               Else
  610.                               Begin  { Ins Off }
  611.                                    Delete(S,Strcnt,1) ;
  612.                                    Insert(Ch,S,Strcnt) ;
  613.                                    Inc(Strcnt) ;
  614.  
  615. clrvp(cx,cy,cx+textwidth(ch),cy+textheight(ch)) ;
  616. if noecho then outtextxy(cx,cy,'.')                                   else
  617. outtextxy(Cx,Cy,ch) ;                                   if strcnt <= length(s)
  618. then                                       begin
  619.                                             ch := s[strcnt] ;
  620.                                             if noecho then outtextxy(cx,cy,'.')
  621.                                             else outtextxy(Cx + spac,Cy,ch) ;
  622.                                        end ;
  623.                                    curson := false ;
  624.                               End ;  { Ins Off }
  625.                               Cx := Cx + Spac ;
  626.                               If Cx <= X2 - Spac Then ppcur(2) ;
  627.                          End    { Not Nomore }
  628.                     End ;   { Real Chars }
  629.           End ; { Case }
  630.      End ;    { Not Done  }
  631.      S[0] := chr(length(s)) ;
  632.      if curson then ppcur(0) ;
  633. End ;  {readxy}
  634. {****************************************************************************}
  635. { Get an Amount of Type Real from a Location }
  636. Function Getreal ;
  637. var
  638.    istr : string ;
  639.    cod : integer ;
  640. begin   { get Amount }
  641.      str(am:1:2,istr) ;
  642.      repeat
  643.           readxy(x,y,istr,w) ; val(istr,am,cod) ;
  644.      until cod = 0 ;
  645.      getreal := am ;
  646. end ;   { get Amount }
  647. {****************************************************************************}
  648. { Get an Amount of type integer from a location x,y  }
  649. Function getinteger  ;
  650. var
  651.    istr : string ;
  652.    cod : integer ;
  653. begin   { Getinteger }
  654.      str(n,istr) ;
  655.      repeat
  656.           readxy(X,y,istr,w) ; val(istr,n,cod) ;
  657.      until cod = 0 ;
  658.      getinteger := n ;
  659. end ;   { Getinteger }
  660. {****************************************************************************}
  661. { Outputs using Outtextxy then GREY's out the text }
  662. Procedure Greyoutxy(x,y : integer ; textstring : string) ;
  663. var
  664.    size,I : integer ;
  665.  
  666. begin
  667.      size := textwidth(textstring) div length(textstring) ;
  668.      outtextxy(x,y,textstring) ;
  669.      for I := 0 to length(textstring)-1 do
  670.         putimage(x + size*I,y,greypic^,andput) ;  { Greyout }
  671. end;
  672. {****************************************************************************}
  673. Function YesNoDialog : boolean ;
  674. const
  675.      boxx = 150 ;
  676.      Boxy = 150 ;
  677. Var
  678.    menudone,Yesno : Boolean ;
  679.    oldstyle : textsettingstype ;
  680.    boxheight,boxwidth,oldcolor,numpressed : word ;
  681.    msx,msy : word ;
  682.    Imagebuffer : pointer ;
  683.    Size : word ;
  684.  
  685. begin  { YesNo Dialog }
  686.      Yesno := false ;
  687.      menudone := false ;
  688.      hidemousecursor ;
  689.      { Save what is under the window before opening it. Also save
  690.         the old textstyle }
  691.      gettextsettings(oldstyle) ;
  692.      oldcolor := getcolor ;
  693.      settextstyle(0,0,1) ;
  694.      boxheight := textheight('H') * 3 ;
  695.      Boxwidth := textwidth('H') * 15;
  696.      size := imagesize(boxx,boxy,boxx + boxwidth,boxy + boxheight) ;
  697.      getmem(imagebuffer,size) ;
  698.      getimage(boxx,boxy,boxx + boxwidth,boxy + boxheight,imagebuffer^) ;
  699.  
  700.      { Now we put the image of the menu down. }
  701.      setfillstyle(1,lightgray) ;
  702.      bar(boxx+3,boxy+3,boxx + boxwidth-3,boxy + boxheight-3) ;
  703.      setcolor(green) ;
  704.      dblbox(boxx,boxy,boxx + boxwidth,boxy + boxheight) ;
  705.      setcolor(brown) ;
  706.      outtextxy(boxx+8,boxy+textheight('H'),' Yes  |  No') ;
  707.      setcolor(oldcolor) ;
  708.      showmousecursor ;
  709.      repeat
  710.           if (getmousex <> msx) or (getmousey <> msy) then
  711.           begin
  712.                msx := getmousex ;
  713.                msy := getmousey ;
  714.           end ;
  715.           if buttonpressed then
  716.           { where was the button pressed?}
  717.           begin
  718.                msx := getmousex ;
  719.                msy := getmousey ;
  720.                if ((msx > boxx+4) and (msx < boxx+boxwidth))
  721.                   and
  722.                   ((msy > boxy) and (msy < boxy+boxheight)) then
  723.                   { it's in the menu box }
  724.                begin
  725.                     { where in the menu Box? }
  726.                     if (msx > boxx) and (msx < boxx+ (boxwidth div 2))
  727.                     then yesno := true ;
  728.                     menudone := true ;
  729.                end ;
  730.           end ;
  731.      until menudone ;
  732.      { when we are done we want to restore all the old settings. }
  733.      with oldstyle do
  734.      begin
  735.           settextjustify(horiz,vert) ;
  736.           settextstyle(font,direction,charsize) ;
  737.      end ;
  738.      { and put the screen back to what it was.. }
  739.      hidemousecursor ;
  740.      putimage(boxx,boxy,imagebuffer^,normalput) ;
  741.      freemem(imagebuffer,size) ;
  742.      showmousecursor ;
  743.      setcolor(oldcolor) ;
  744.      yesnodialog := yesno ;
  745. end;
  746. {****************************************************************************}
  747. End.   { End of grfxutil }
  748. {
  749.     The routines you might be interested in are in the later half of
  750.  that unit In the previous posts.  It provided a fully editable
  751.  Graphical Data Entry (either string, real, or integer) line.  It
  752.  supports the arrow keys, Home, end, backspace, del, insert, and escape
  753.  clears the whole line.  Enter accepts the input.  You can specify how
  754.  many characters wide the input field should be, and the numerical input
  755.  routines, Getreal, and getinteger do some primitive checking to make
  756.  sure that input is correct.  Also, (it's been a long time since I've
  757.  used this so bear with my bad memory) I believe you call them with the
  758.  value of an already initialized variable so that if the user just hits
  759.  enter it doesn't change the value.  I've used it in conjunction with a
  760.  mouse pointer and since the readxy routine is command driven (using the
  761.  getcommand supplied in there too,) you can issue it an enter with the
  762.  mouse buttons.  So you can click around in various fields with your
  763.  mouse.  Of course you have to make that routine yourself!
  764.  
  765.     Oh!  I should tell you, delete the refferences to mouseutil and the
  766.  single mouse function, sorry, I shouldn't have included that one with
  767.  it.. You might not have mousutil!
  768. }
  769.